home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / src_d2.zoo / source / search.c < prev    next >
C/C++ Source or Header  |  1991-12-02  |  38KB  |  1,312 lines
  1. /* String search routines for GNU Emacs.
  2.    Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23. #include "syntax.h"
  24. #include "buffer.h"
  25. #include "commands.h"
  26. #include "regex.h"
  27.  
  28. #define max(a, b) ((a) > (b) ? (a) : (b))
  29. #define min(a, b) ((a) < (b) ? (a) : (b))
  30.  
  31. unsigned char downcase_table[01000] = {0};    /* folds upper to lower case */
  32.           /* A WHEEL WILL FALL OFF IF, IN A trt, CHARACTER A */
  33.           /* TRANSLATES INTO CHARACTER B AND CHARACTER B DOES NOT */
  34.           /* ALSO TRANSLATE INTO CHARACTER B. */ 
  35. /* If that constraint is met, compute_trt_inverse will follow a */
  36.  /* translation table with its inverse.  The inverse of a table */
  37.  /* follows the table at table[0400].  The form of this is that if */
  38.  /* table[a]=b then the chain starting at table[0400+b], linked by */
  39.  /* link(x)=table[0400+x] and ended by b must include a. */
  40.  
  41. /* At present compute_trt_inverse is blinded and the inverse for this */
  42.  /* particular table is created by a single-purpose loop. */
  43.  /* compute_trt_inverse has been tested on the following cases: */
  44.  /* trt[x]=x, trt[x]=(+ 3 (logand x, 0370)), trt[x]='a', and the */
  45.  /* downcase table. */
  46.  
  47. /* We compile regexps into this buffer and then use it for searching. */
  48.  
  49. struct re_pattern_buffer searchbuf;
  50.  
  51. char search_fastmap[0400];
  52.  
  53. /* Last regexp we compiled */
  54.  
  55. Lisp_Object last_regexp;
  56.  
  57. /* Every call to re_match, etc., must pass &search_regs as the regs argument
  58.  unless you can show it is unnecessary (i.e., if re_match is certainly going
  59.  to be called again before region-around-match can be called).  */
  60.  
  61. static struct re_registers search_regs;
  62.  
  63. /* error condition signalled when regexp compile_pattern fails */
  64.  
  65. Lisp_Object Qinvalid_regexp;
  66.  
  67. /* Compile a regexp and signal a Lisp error if anything goes wrong.  */
  68.  
  69. compile_pattern (pattern, bufp, translate)
  70.      Lisp_Object pattern;
  71.      struct re_pattern_buffer *bufp;
  72.      char *translate;
  73. {
  74.   char *val;
  75.   Lisp_Object dummy;
  76.  
  77.   if (EQ (pattern, last_regexp)
  78.       && translate == bufp->translate)
  79.     return;
  80.   last_regexp = Qnil;
  81.   bufp->translate = translate;
  82.   val = re_compile_pattern (XSTRING (pattern)->data,
  83.                 XSTRING (pattern)->size,
  84.                 bufp);
  85.   if (val)
  86.     {
  87.       dummy = build_string (val);
  88.       while (1)
  89.     Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
  90.     }
  91.   last_regexp = pattern;
  92.   return;
  93. }
  94.  
  95. /* Error condition used for failing searches */
  96. Lisp_Object Qsearch_failed;
  97.  
  98. Lisp_Object
  99. signal_failure (arg)
  100.      Lisp_Object arg;
  101. {
  102.   Fsignal (Qsearch_failed, Fcons (arg, Qnil));
  103.   return Qnil;
  104. }
  105.  
  106. DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
  107.   "t if text after point matches regular expression PAT.")
  108.   (string)
  109.      Lisp_Object string;
  110. {
  111.   Lisp_Object val;
  112.   unsigned char *p1, *p2;
  113.   int s1, s2;
  114.   register int i;
  115.  
  116.   CHECK_STRING (string, 0);
  117.   compile_pattern (string, &searchbuf,
  118.            !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);
  119.  
  120.   immediate_quit = 1;
  121.   QUIT;            /* Do a pending quit right away, to avoid paradoxical behavior */
  122.  
  123.   /* Get pointers and sizes of the two strings
  124.      that make up the visible portion of the buffer. */
  125.  
  126.   p1 = BEGV_ADDR;
  127.   s1 = GPT - BEGV;
  128.   p2 = GAP_END_ADDR;
  129.   s2 = ZV - GPT;
  130.   if (s1 < 0)
  131.     {
  132.       p2 = p1;
  133.       s2 = ZV - BEGV;
  134.       s1 = 0;
  135.     }
  136.   if (s2 < 0)
  137.     {
  138.       s1 = ZV - BEGV;
  139.       s2 = 0;
  140.     }
  141.   
  142.   val = (0 <= re_match_2 (&searchbuf, p1, s1, p2, s2,
  143.               point - BEGV, &search_regs, ZV - BEGV)
  144.      ? Qt : Qnil);
  145.   for (i = 0; i < RE_NREGS; i++)
  146.     if (search_regs.start[i] >= 0)
  147.       {
  148.     search_regs.start[i] += BEGV;
  149.     search_regs.end[i] += BEGV;
  150.       }
  151.   immediate_quit = 0;
  152.   return val;
  153. }
  154.  
  155. DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
  156.   "Return index of start of first match for REGEXP in STRING, or nil.\n\
  157. If third arg START is non-nil, start search at that index in STRING.\n\
  158. For index of first char beyond the match, do (match-end 0).\n\
  159. match-end and match-beginning also give indices of substrings\n\
  160. matched by parenthesis constructs in the pattern.")
  161.   (regexp, string, start)
  162.      Lisp_Object regexp, string, start;
  163. {
  164.   int val;
  165.   int s;
  166.  
  167.   CHECK_STRING (regexp, 0);
  168.   CHECK_STRING (string, 1);
  169.  
  170.   if (NULL (start))
  171.     s = 0;
  172.   else
  173.     {
  174.       int len = XSTRING (string)->size;
  175.  
  176.       CHECK_NUMBER (start, 2);
  177.       s = XINT (start);
  178.       if (s < 0 && -s <= len)
  179.     s = len - s;
  180.       else if (0 > s || s > len)
  181.     args_out_of_range (string, start);
  182.     }
  183.  
  184.   compile_pattern (regexp, &searchbuf,
  185.            !NULL (current_buffer->case_fold_search) ? (char *) downcase_table : 0);
  186.   immediate_quit = 1;
  187.   val = re_search (&searchbuf, XSTRING (string)->data, XSTRING (string)->size,
  188.                    s, XSTRING (string)->size - s, &search_regs);
  189.   immediate_quit = 0;
  190.   if (val < 0) return Qnil;
  191.   return make_number (val);
  192. }
  193.  
  194. scan_buffer (target, pos, cnt, shortage)
  195.      int *shortage, pos;
  196.      register int cnt, target;
  197. {
  198.   int lim = ((cnt > 0) ? ZV - 1 : BEGV);
  199.   int direction = ((cnt > 0) ? 1 : -1);
  200.   register int lim0;
  201.   unsigned char *base;
  202.   register unsigned char *cursor, *limit;
  203.  
  204.   if (shortage != 0)
  205.     *shortage = 0;
  206.  
  207.   immediate_quit = 1;
  208.  
  209.   if (cnt > 0)
  210.     while (pos != lim + 1)
  211.       {
  212.     lim0 =  BufferSafeCeiling (pos);
  213.     lim0 = min (lim, lim0);
  214.     limit = &FETCH_CHAR (lim0) + 1;
  215.     base = (cursor = &FETCH_CHAR (pos));
  216.     while (1)
  217.       {
  218.         while (*cursor != target && ++cursor != limit)
  219.           ;
  220.         if (cursor != limit)
  221.           {
  222.         if (--cnt == 0)
  223.           {
  224.             immediate_quit = 0;
  225.             return (pos + cursor - base + 1);
  226.           }
  227.         else
  228.           if (++cursor == limit)
  229.             break;
  230.           }
  231.         else
  232.           break;
  233.       }
  234.     pos += cursor - base;
  235.       }
  236.   else
  237.     {
  238.       pos--;            /* first character we scan */
  239.       while (pos > lim - 1)
  240.     {            /* we WILL scan under pos */
  241.       lim0 =  BufferSafeFloor (pos);
  242.       lim0 = max (lim, lim0);
  243.       limit = &FETCH_CHAR (lim0) - 1;
  244.       base = (cursor = &FETCH_CHAR (pos));
  245.       cursor++;
  246.       while (1)
  247.         {
  248.           while (--cursor != limit && *cursor != target)
  249.         ;
  250.           if (cursor != limit)
  251.         {
  252.           if (++cnt == 0)
  253.             {
  254.               immediate_quit = 0;
  255.               return (pos + cursor - base + 1);
  256.             }
  257.         }
  258.           else
  259.         break;
  260.         }
  261.       pos += cursor - base;
  262.     }
  263.     }
  264.   immediate_quit = 0;
  265.   if (shortage != 0)
  266.     *shortage = cnt * direction;
  267.   return (pos + ((direction == 1 ? 0 : 1)));
  268. }
  269.  
  270. int
  271. find_next_newline (from, cnt)
  272.      register int from, cnt;
  273. {
  274.   return (scan_buffer ('\n', from, cnt, (int *) 0));
  275. }
  276.  
  277. DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
  278.   "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
  279. CHARS is like the inside of a [...] in a regular expression\n\
  280. except that ] is never special and \\ quotes ^, - or \\.\n\
  281. Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
  282. With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
  283.   (string, lim)
  284.      Lisp_Object string, lim;
  285. {
  286.   skip_chars (1, string, lim);
  287.   return Qnil;
  288. }
  289.  
  290. DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
  291.   "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
  292. See skip-chars-forward for details.")
  293.   (string, lim)
  294.      Lisp_Object string, lim;
  295. {
  296.   skip_chars (0, string, lim);
  297.   return Qnil;
  298. }
  299.  
  300. skip_chars (forwardp, string, lim)
  301.      int forwardp;
  302.      Lisp_Object string, lim;
  303. {
  304.   register unsigned char *p, *pend;
  305.   register unsigned char c;
  306.   unsigned char fastmap[0400];
  307.   int negate = 0;
  308.   register